PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/timicon.exe/TIMICON.PAS

Pascal/Delphi Source File | 1991-07-20 | 5.6 KB | 205 lines

{*************************************************************************************
 Creator:  Jack C. Mackey
 Program:  TIMICON - Time Watch Icon
 Date   :  07/19/91
 Comments:
   An example program, implementing the techniques used to create the
   FREEMEM program delineated in 'Progamming Windows 3' C. Petzold.

   Use at your own risk. There is no implied warranty of any kind.

   TIMICON will display a default program ICON and the current
   time within. The current time is displayed with 'AM' or 'PM'.

   I hope this will be of some use to those heading down the TPW road.
 *************************************************************************************}


USES windos,strings,wintypes,winprocs;



FUNCTION winproc(window : hwnd;
                 message: word;
                 wparam : word;
                 lparam : longint) : longint; export;
CONST
  minupdate: word = 1; {update Icon every minupdate mins.}
  twhour   : word = 0; {current hour}
  twphour  : word = 0; {previous hour}
  twmin    : word = 0; {current mins.}
  twpmin   : word = 0; {previous mins.}
  twsec    : word = 0;
  twsec100 : word = 0;
                      {12345678901234567890}
  pbufr   : pchar   = '                    ';
  fid_timer = 1;
  frect : trect = (left  : 0;
                   top   : 0;
                   right : 0;
                   bottom: 0);
VAR
  devcont  : hdc;
  ps       : tpaintstruct;
  tempstr  : string[20];
  twminstr : string[3];
  clen     : integer;
  prnthour : word;
  twampm   : string[4];

BEGIN
  winproc := 0;
  CASE message
  OF
    wm_timer: BEGIN
                gettime(twhour,twmin,twsec,twsec100);
                IF (twhour - twphour <> 0)
                OR (twmin  - twpmin  >=  minupdate)
                THEN
                BEGIN
                  invalidaterect(window, nil, true);
                  twphour  := twhour;
                  twpmin   := twmin;
                END;
              END;
    wm_size : BEGIN
                getclientrect(window,frect);
              END;
    wm_paint: BEGIN
                devcont := beginpaint(window,ps);
                tempstr := '';
                twminstr:= '';
                prnthour := twhour mod 12;
                IF   twhour = 0
                THEN prnthour := 12;
                IF twhour > 11
                THEN twampm := '  PM'
                ELSE twampm := '  AM';
                str(prnthour:2, tempstr);
                IF tempstr[1] = ' '
                THEN tempstr[1] := '0';
                str(twmin:2,twminstr);
                IF twminstr[1] = ' '
                THEN twminstr[1] := '0';
                tempstr := concat(tempstr,strpas(':'));
                tempstr := concat(tempstr,twminstr);
                tempstr := concat(tempstr,twampm);
                strpcopy(pbufr,tempstr);
                clen := length(tempstr);
                drawtext(devcont,pbufr,clen,frect,dt_wordbreak);
                endpaint(window,ps);
              END;
    wm_queryopen: BEGIN
                  END;
    wm_destroy: BEGIN
                  killtimer(window,fid_timer);
                  postquitmessage(0);
                END;
    ELSE
    BEGIN
      winproc := defwindowproc(window,message,wparam,lparam);
    END;
  END;
END;

PROCEDURE winmain;
CONST
  appname   = 'Time Watch';
  idm_about = 100;
  fid_timer = 1;
  wclass : twndclass =(style        : 0;
                       lpfnwndproc  : nil;
                       cbclsextra   : 0;
                       cbwndextra   : 0;
                       hinstance    : 0;
                       hicon        : 0;
                       hcursor      : 0;
                       hbrbackground: 0;
                       lpszmenuname : appname;
                       lpszclassname: appname);


VAR
  window : hwnd;
  message: tmsg;
  devcont: hdc;
  tm     : ttextmetric;
BEGIN
  IF hprevinst = 0
  THEN
  BEGIN
    wclass.style       := cs_hredraw xor cs_vredraw;
    wclass.lpfnwndproc := @winproc;
    wclass.cbclsextra  := 0;
    wclass.cbwndextra  := 0;
    wclass.hinstance   := hinstance;
    wclass.hicon       := 0;
    wclass.hcursor     := loadcursor(0,idc_arrow);
    wclass.hbrbackground:=getstockobject(white_brush);
    wclass.lpszclassname:= appname;
    IF registerclass(wclass) = false
    THEN
    BEGIN
       halt(255);
       {error registering class}
    END;
    window := createwindow(appname,'TP-Watch',
                           ws_overlappedwindow,
                           cw_usedefault, cw_usedefault,
                           cw_usedefault, cw_usedefault,
                           0,0,hinstance,nil);
    devcont := getdc(window);
    gettextmetrics(devcont, tm);
    releasedc(window,devcont);
    IF (4 * tm.tmavecharwidth > getsystemmetrics(sm_cxicon))
    OR (2 * tm.tmheight       > getsystemmetrics(sm_cyicon))
    THEN
    BEGIN
      messagebox(window,'Icon is to small for Free Memory Display',
                 appname, mb_iconexclamation xor mb_ok);
    END
    ELSE
    BEGIN
      IF settimer(window,fid_timer,1000,nil) = 0
      THEN
      BEGIN
        messagebox(window,'Cannot Set timer for Free Memory Display',
                   appname, mb_iconexclamation xor mb_ok);
      END
      ELSE
      BEGIN
        showwindow(window,sw_showminnoactive);
        updatewindow(window);
        WHILE getmessage(message,0,0,0) = true
        DO
        BEGIN
          translatemessage(message);
          dispatchmessage(message);
        END;
      END;
    END;
  END;
END;



BEGIN
  winmain;
END.